Komputer for Alle 2003 #3/K-CD-3-2003.ISO/WinXP Service Pack 1/xpsp1_sv_x86.exe/ipp_util.in_/ipp_util.inc

Text File | 2002-08-01 | 13.7 KB | 415 lines

<%
'------------------------------------------------------------
'
' Microsoft Internet Printing Project
'
' Copyright (c) Microsoft Corporation. All rights reserved.
'
'------------------------------------------------------------
%>

<%

Const L_DocumentList_Text   = "Dokumentlista"
Const L_DerivedFont_Text    = " face=""Tahoma, Verdana, Arial, MS Sans Serif"" "
Const L_DoubleDevFont_Text  = " face=""""Tahoma, Verdana, Arial, MS Sans Serif"""" "

Const PROGID_CLIENT_HELPER  = "OlePrn.PrinterURL"
Const PROGID_SNMP           = "OlePrn.OleSNMP"
Const PROGID_HELPER         = "OlePrn.AspHelp"
Const PROGID_CONVERTER      = "OlePrn.OleCvt"
Const PROGID_ADDPRINTER     = "OlePrn.AddPrint"
Const VIEW_EQUALS           = "&view="
Const ONCLICK_EQUALS        = " onclick="
Const QUOTE                 = """"
Const QUEUE_VIEW            = "ipp_0007.asp"
Const PROPERTY_VIEW         = "ipp_0006.asp"
Const UNAUTHORIZED_401      = "401 Unauthorized"
Const FAXDRIVER             = "Microsoft Shared Fax Driver"

Const COMPUTER              = "MS_Computer"
Const LOCAL_SERVER          = "MS_LocalServer"
Const DHTML_ENABLED         = "MS_DHTMLEnabled"
Const DEFAULT_PAGE          = "MS_DefaultPage"
Const PRINTER               = "MS_Printer"
Const URLPRINTER            = "MS_URLPrinter"
Const SNMP                  = "MS_SNMP"
Const IPADDRESS             = "MS_IPAddress"
Const COMMUNITY             = "MS_Community"
Const DEVICE                = "MS_Device"
Const PORTNAME              = "MS_Portname"
Const MODEL                 = "MS_Model"
Const ASP1                  = "MS_ASP1"
Const CONNECT               = "showconnect"
Const ATPRINTER             = "&MS_Printer="
Const ATURLPRINTER          = "&MS_URLPrinter="
Const ATSNMP                = "&MS_SNMP="
Const ATIPADDRESS           = "&MS_IPAddress="
Const ATCOMMUNITY           = "&MS_Community="
Const ATDEVICE              = "&MS_Device="
Const ATPORTNAME            = "&MS_Portname="
Const ATMODEL               = "&MS_Model="
Const ATASP1                = "&MS_ASP1="
Const ATPAGE                = "&page="
Const ATCONNECT             = "&showconnect="

Dim   DEF_FONT, DEF_BASEFONT_TAG, DEF_FONT_TAG, LARGE_FONT_TAG, MENU_FONT_TAG
Dim   SUBMENU_FONT, SUBMENU_FONT_TAG, CLIENT_FONT, DEF_DOUBLEFONT, DEF_DOUBLEFONT_TAG

DEF_FONT                    = L_DerivedFont_Text
DEF_DOUBLEFONT              = L_DoubleDevFont_Text
DEF_BASEFONT_TAG            = "<basefont  " & L_DerivedFont_Text & " size=2>"
DEF_FONT_TAG                = "<font " & L_DerivedFont_Text & " size=2>"
LARGE_FONT_TAG              = "<font " & L_DerivedFont_Text & " size=4>"
MENU_FONT_TAG               = "<font " & L_DerivedFont_Text & " size=2 color=white>"
SUBMENU_FONT                = L_DerivedFont_Text & " size=1 "
SUBMENU_FONT_TAG            = "<font " & L_DerivedFont_Text & " size=2>"
CLIENT_FONT                 = "<font " & L_DerivedFont_Text & ">"
Const END_FONT              = "</font>"

'Initialize UTF8 related information
Dim bUTF8
Dim OleCvt

Function bUTF8Capable
    Dim objBrowcap

    Set objBrowcap = server.CreateObject("MSWC.browsertype")
    If (objBrowcap.browser = "IE" Or objBrowcap.browser = "Netscape")  And objBrowcap.majorver >= "4" Then
        bUTF8Capable = True
    Else
        bUTF8Capable = False
    End If
End Function


Sub InitCodepage ()
    Set OleCvt = Server.CreateObject (PROGID_CONVERTER)

    bUTF8 = bUTF8Capable
    If bUTF8 Then
        Session.Codepage = 65001
    End If

End Sub

InitCodePage

Function SetCodePage ()
    If (bUTF8) Then 'If not UTF enabled, use the default charset
        SetCodePage = "<Meta Http-equiv=""Content-Type"" Content=""text/html; CHARSET=UTF-8"">"
    Else
        SetCodePage = ""
    End If
End Function

Function Write (strUnicode)
    Write = strUnicode
End Function

Function SubstituteString(strIn, strPattern, strReplacement)
    Dim iStrPos

    iStrPos = InStr(strIn,strPattern)
    SubstituteString = Left(strIn, iStrPos-1) & strReplacement & Mid(strIn, iStrPos + Len(strPattern))
End Function

Function RepString1( strIn, strRep )
    RepString1 = SubStituteString( strIn, "%1", strRep)
End Function

Function RepString2( strIn, strRep1, strRep2 )
    RepString2 = SubStituteString( RepString1(strIn, strRep1) , "%2", strRep2)
End Function

Function RepString3( strIn, strRep1, strRep2, strRep3 )
    RepString3 = SubStituteString( RepString2(strIn, strRep1, StrRep2), "%3", strRep3)
End Function

Function GenErrorPage (iCode, strSource, strDscp, strNote)
    Dim strHTML
    Const L_ErrCode_Text      = "<b>Felkod:</b>"
    Const L_ErrDscp_Text      = "<b>Beskrivning:</b>"
    Const L_ErrNote_Text      = "<b>Obs!</b>"
    Const L_ErrTitle_Text     = "Internet-utskriftsfel"
    Const L_ErrSource_Text    = "Felet inträffade i <b>%1</b>"
    Const L_ErrOccurProc_Text = "<p>Ett <b>fel</b> inträffade när begäran behandlades.</p>"

    strHTML = "<html><head><title>" & L_ErrTitle_Text & "</title>"
    strHTML = strHTML & SetCodePage
    strHTML = strHTML & "</head><body bgcolor=#FFFFFF>" & DEF_BASEFONT_TAG
    strHTML = strHTML & L_ErrOccurProc_Text

    If strSource <> "" Then
        strHTML = strHTML & RepString1(L_ErrSource_Text, strSource)
    End If

    strHTML = strHTML & "<table>"

    strHTML = strHTML & "<tr><td>" & L_ErrCode_Text & "</td><td>" & (Hex (iCode)) & "</td></tr>"

    If strDscp <> "" Then
        strHTML = strHTML & "<tr><td>" & L_ErrDscp_Text & "</td><td>" & strDscp & "</td></tr>"
    End If

    If strNote <> "" Then
        strHTML = strHTML & "<tr><td>" & L_ErrNote_Text & "</td><td>" & strNote & "</td></tr>"
    End If

    strHTML = strHTML & "</table></body></html>"
    GenErrorPage = strHTML
End Function

Sub ErrorHandler(strNotes)
    Dim strDscp, strSource

    Dim str401Error

    If Err.Number = 70 Or Err.Number = &H80070005 Then
        Const L_ErrTitle_Text = "Autentiseringsfel f├╢r Internet-utskrift"
        Const L_ErrTitle2_Text = "Autentiseringen misslyckades"
        Const L_ErrLine1_Text = "Felet inträffade eftersom den åtgärd du försökte utföra kräver högre privilegium än ditt konto har."
        Const L_ErrLine2_Text = "Kontakta systemadministratören och kontrollera att du har privilegium att utföra åtgärden."

        str401Error = "<html><head><title>" & L_ErrTitle_Text & "</title>" &_
            SetCodePage &_
            "</head>" &_
            "<body bgcolor=#FFFFFF>" &_
            DEF_FONT_TAG &_
            "<p><H2>" & L_ErrTitle2_Text & "</H2></p>" &_
            "<p>" & L_ErrLine1_Text &_
            "<br>" &_
            "<br>" & L_ErrLine2_Text & "</p>" &_
            "</font></body></html>"
        response.write (Write(str401Error))
        response.status = UNAUTHORIZED_401
    Else
        If Err.Number = &H80070709 Then
            Const L_ErrInvalidName_Text = "Skrivaren kunde inte hittas på servern. Det gick inte att ansluta."
            Err.Description = L_ErrInvalidName_Text
        End If

        response.write(Write(GenErrorPage (Err.Number, Err.Source, Err.Description, strCleanString(strNotes))))
    End If
    response.Expires = 0
    response.end

End Sub

Function bDHTMLSupported()
    On Error Resume Next
    Err.Clear
    Dim objBrowcap

    Set objBrowcap = server.CreateObject("MSWC.browsertype")
    If Not Err And objBrowcap.browser = "IE" And objBrowcap.majorver >= "4" Then
        bDHTMLSupported = True
    Else
        bDHTMLSupported = False
    End If
End Function

Sub CheckSession()
    ' check to see if the session has timed out
    If Session(COMPUTER) = "" Then
        response.redirect ("ipp_0003.asp")
        response.end
    End If
End Sub

Function strPrinterStatus(iStatus)
    Dim L_PrinterStatus_Text(24)
    Const L_Seperator_Text = " - "
    Const L_PrinterReady_Text = "Redo"

    L_PrinterStatus_Text(0)  = "Pausad"
    L_PrinterStatus_Text(1)  = "Fel"
    L_PrinterStatus_Text(2)  = "Tar bort"
    L_PrinterStatus_Text(3)  = "Papperet har fastnat"
    L_PrinterStatus_Text(4)  = "Papperet är slut"
    L_PrinterStatus_Text(5)  = "Manuell matning krävs"
    L_PrinterStatus_Text(6)  = "Pappersproblem"
    L_PrinterStatus_Text(7)  = "Skrivaren är offline"
    L_PrinterStatus_Text(8)  = "I/O aktivt"
    L_PrinterStatus_Text(9)  = "Upptagen"
    L_PrinterStatus_Text(10) = "Skriver ut"
    L_PrinterStatus_Text(11) = "Utmatningsfacket är fullt"
    L_PrinterStatus_Text(12) = "Inte tillgänglig"
    L_PrinterStatus_Text(13) = "Väntar"
    L_PrinterStatus_Text(14) = "Arbetar"
    L_PrinterStatus_Text(15) = "Initierar"
    L_PrinterStatus_Text(16) = "Värmer upp"
    L_PrinterStatus_Text(17) = "Lite toner kvar"
    L_PrinterStatus_Text(18) = "Ingen toner kvar"
    L_PrinterStatus_Text(19) = "Pappersproblem"
    L_PrinterStatus_Text(20) = "Åtgärder från användaren krävs"
    L_PrinterStatus_Text(21) = "Det finns inget ledigt minne"
    L_PrinterStatus_Text(22) = "Luckan är öppen"
    L_PrinterStatus_Text(23) = "Serverstatus okänd"
    L_PrinterStatus_Text(24) = "Energisparläge"

    Dim bit, i
    bit = 1
    i = 0
    Dim strHTML, bFirst

    bFirst = True
    strHTML = ""

    For i = 0 To 24
    If iStatus And bit Then
        If Not bFirst Then
        strHTML = strHTML + L_Seperator_Text
        End If
        strHTML = strHTML + L_PrinterStatus_Text(i)
            bFirst = False
    End If
        bit = bit * 2
    Next
    If bFirst Then
        strHTML = "<font color=green>" & L_PrinterReady_Text & "</font>"
    Else
        strHTML = "<font color=red>" & strHTML & "</font>"
    End If

    strPrinterStatus = strHTML
End Function

Function strFormatJobSize(iJobSize)
    Const  L_Bytes_Text     = "%1 byte"
    Const  L_KiloBytes_Text = "%1 kB"
    Const  L_MegaBytes_Text = "%1 MB"


    If iJobSize < 1024 Then
        strFormatJobSize = RepString1(L_Bytes_Text, CStr(iJobSize) )
    ElseIf iJobSize < 1048576 Then
        strFormatJobSize = RepString1(L_KiloBytes_Text, formatnumber(iJobSize / 1024, 1) )
    Else
        strFormatJobSize = RepString1(L_MegaBytes_Text, formatnumber(iJobSize / (1024 * 1024), 1) )
    End If
End Function

Function strFormatString(str)
    If str = "" Then
        strFormatString = " "
    Else
        strFormatString = str
    End If
End Function

Function strCleanString (str)

    Dim strClean, i, iLength, ch

    strClean = ""
    iLength = Len (str)

    For i = 1 To iLength
        ch = Mid (str, i, 1)

        Select Case ch
        Case "<"
            strClean = strClean & "<"
        Case ">"
            strClean = strClean & ">"
        Case """"
            strClean = strClean & """
        Case "&"
            strClean = strClean & "&"
        Case Else
            strClean = strClean & ch
        End Select
    Next
    strCleanString = strClean

End Function

Function strCleanRequest (str)

    strCleanRequest = strCleanString (Request(str))

End Function

Function JobEtaInfo (objPrinter)
    Dim strTime, iJobCount, iMinute
    Dim strHTML

    Const L_NoJobPending_Text = "    <b>Väntetid:</b> 0 <br><b>Väntande dokument:</b> 0 "
    Const L_ErrorNoJobCompletion_Text = "<font color=red>Utskriftsfel</font> "
    Const L_LongHour_Text = "> 8 timmar"
    Const L_About_Text = "ungefär "
    Const L_Hour_Text = " timmar"
    Const L_Minute_Text = " minuter"

    Const L_QueueStatus_Text = "<b>Utskriftsk├╢:</b> "
    Const L_WaitingTime_Text = "      <b>Väntetid:</b> "
    Const L_Unknown_Text = "Okänd"
    Const L_JobPending_Text = "<b>Väntande dokument:</b> "
    Const L_AvgSize_Text = "      <b>Medelstorlek:</b> "
    Const L_Pages_Text =  " sidor"


    strHTML = L_QueueStatus_Text & strPrinterStatus (objPrinter.Status) & L_WaitingTime_Text

    objPrinter.CalcJobETA

    If ( objPrinter.Status And &H9F ) Then
        strHTML = strHTML & L_Unknown_Text
    'End If
    'If 1 Then
    Else
        If objPrinter.PendingJobCount = 0 Then
            strHTML = strHTML & "0"
        Else
            iMinute = objPrinter.JobCompletionMinute
            'iMinute = 240  'For testing purpose
            If iMinute <> -1 Then
                If iMinute > 480 Then
                    strTime = L_LongHour_Text
                Elseif iMinute > 60 Then
                    strTime = L_About_Text & CStr (Int (iMinute / 60)) & L_Hour_Text
                Else
                    strTime = L_About_Text & CStr (iMinute) & L_Minute_Text
                End If
                strHTML = strHTML & strTime
            Else
                strHTML = strHTML & L_Unknown_Text
            End If
        End If
    End If

    strHTML = strHTML & "<br>"
    iJobCount = objPrinter.PendingJobCount
    strHTML = strHTML & L_JobPending_Text & CStr (iJobCount)

    If iJobCount > 0 Then
        strHTML = strHTML & L_AvgSize_Text
        If ObjPrinter.AvgJobSizeUnit = 1 Then 'Page
            strHTML = strHTML & CStr (ObjPrinter.AvgJobSize) + L_Pages_Text
        Else
            strHTML = strHTML & strFormatJobSize(ObjPrinter.AvgJobSize)
        End If
    End If

    JobEtaInfo = "<font " & DEF_FONT & "size= -1>" & strHTML & "</font>"

End Function

Function GetFriendlyName (strPrtName, strComputer)

    Dim lOffset, strServerName

    If Left (strPrtName, 2) = "\\" Then
        lOffset = InStr (3, strPrtName, "\")
        strServerName = Mid (strPrtName, 3, lOffset - 3)
        If strServerName = strComputer Then 'Cut the server name only if it is same as the computer name
            strPrtName = Mid (strPrtName, lOffset + 1)
        End If
    End If
    GetFriendlyName = strPrtName

End Function

%>